perm filename NTSB.OLD[XX,LCS]3 blob
sn#220911 filedate 1976-06-23 generic text, type T, neo UTF8
00100 TITLE NOTWRT
00200 ENTRY NOTWRT
00300 EXTERNAL BM,NOZERO,LINX,ROFF,CENTX,STF,LINES,.COMM.,MAKNUM
00400 EXTERNAL NTS,EXTRA,REST,ALPHA,DRWNT,FONT,BREP,FERMTA
00500 EXTERNAL DAT,RHORZ,CLEFS,PLTR,MIN,POSI,ALF,RDRAW,AMOD,RJBX
00600 %TEMP.: 0
00700 DEFINE R3< .COMM.+4 >↔DEFINE R4< .COMM.+5 >↔DEFINE R5< .COMM.+6 >
00800 DEFINE R6< .COMM.+7 >↔DEFINE R7< .COMM.+=8 >↔DEFINE J3< .COMM.+=24 >
00900 DEFINE J4< .COMM.+=25 >↔DEFINE J5< .COMM.+=26 >↔DEFINE J6< .COMM.+=27 >
01000 DEFINE J8< .COMM.+=29 >↔DEFINE R9< .COMM.+=10 >↔DEFINE R8< .COMM.+=9 >
01100 DEFINE J2< .COMM.+3 >↔DEFINE J10< .COMM.+=31 >↔DEFINE J7< .COMM.+=28 >
01200 DEFINE RMINI< ALF+=49 >↔DEFINE RINV< ALF+=50 >↔DEFINE RJZ< .COMM.+=23 >
01300 DEFINE RA< ALF+=51 >↔DEFINE RX< ALF+=52 >↔DEFINE RJX< ALF+=53 >
01400 DEFINE RJY< ALF+=54 >↔DEFINE RB< ALF+=55 >↔DEFINE RJW< ALF+=56 >
01500 DEFINE RZ< ALF+=57 >↔DEFINE JX< ALF+=58 >↔DEFINE RG< ALF+=59 >
01600 DEFINE KL< ALF+=60 >↔DEFINE RJAC< ALF+=61 >↔DEFINE K < ALF+=62 >
01700 DEFINE L < ALF+=63 >↔DEFINE RQ< ALF+=64 >↔DEFINE RH< ALF+=65 >
01800 DEFINE J5X< ALF+=66 >↔DEFINE RXX< ALF+=67 >↔DEFINE JJJ< ALF+=68 >
01900 DEFINE JY< ALF+=70 >↔DEFINE RJ< ALF+=71 >↔DEFINE RSTJ2< STF+=8 >
02000 DEFINE PLT< PLTR >↔DEFINE POS< POSI+=9 >↔DEFINE JA< .COMM.+1 >
02100 DEFINE CENTR< .COMM.+2 >↔DEFINE RACNT< DAT >↔DEFINE RDOT< DAT+=65 >
02200 DEFINE XAC< DAT+=82 >↔DEFINE RACCI< DAT+=111 >↔DEFINE NACCI< DAT+=133 >
02300 DEFINE STEM < .COMM.+=43>
02400 ; 00010 C********** FOR NOTE DRAWING, RESTS ACCENT AND OTHER MARKS.
02500 ; 00100 SUBROUTINE NOTWRT
02600 ; 00200 IMPLICIT INTEGER(A-Q,S-Z)
02700 ; 00300 COMMON/DL/IXRX,M,AA /FONT/JFONT
02800 ;00600 COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
02900 ; 00700 REAL DIS,CENTR,POS,STFF
03000 ; 00800 COMMON /STF/RSTFAC(-3/4),RSTJ2
03100 ; 00900 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
03200 ; 01000 COMMON/PLTR/PLT,RHT,DIS /POSI/STFF(-3/4),JJ2,POS
03300 ;01110 C ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
03400 ;01200 COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
03500 ; 01300 1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,J5X,RXX,JJJ,
03600 ; 01400 1 PUNCT,JY,RJ
03700 ;01500 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2))
03800 ;01600 1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8)),
03900 ;01700 1(J11,JQ(9)),(J6,JQ(4)),(R5,RJQ(3)),(R11,RJQ(9)),(STEM,JQ(20))
04000 ;01800 1,(R8,RJQ(6)),(R7,RJQ(5)),(RX,JRX),(RJZ,RJQ(20)),(R3,RJQ(1))
04100 ; 01850 1,(RX4,JQ(19)),(J5X,RZTM)
04200 NOTWRT: 0
04300 ; 04300 RSTX=RSTJ2
04400 MOVE 02,RSTJ2
04500 MOVEM 02,ALF+=48
04600 ; 04400 C FOR MINIS AT 245
04700 ; 04500 RMINI=RSTJ2
04800 MOVEM 02,RMINI
04900 ; 04600 C OR SHOULD THIS ONLY BE IN NOTES, ETC? 15/9/72
05000 ; 04100 RST7=7.*RSTJ2
05100 FMPRI 02,203700
05200 MOVEM 02,ALF+=46
05300 ; 04800 RINV=1
05400 MOVSI 02,201400
05500 MOVEM 02,RINV
05600 ; 04810 RX4=R4
05700 MOVE 02,R4
05800 MOVEM 02,.COMM.+=42
05900 MOVE JA ; 04900 IF(JA.EQ.1)GO TO 11
06000 CAIN 1
06100 JRST A11
06200 CAIN =9 ;05000 IF(JA.EQ.9)GO TO 242
06500 JRST A242
06600 ; 05200 C NEXT IS FOR RESTS
06700 MOVM J4 ; 05210 IF(IABS(J4).LT.480)GO TO 302
06800 CAIGE 00,740
06900 JRST A302
07000 ; 05220 C P4+500= USER-ADDED RESTS
07100 ; 05230 CALL EXTRA
07200 JSA 16,EXTRA
07300 ; 05240 RETURN
07400 JRA 16,(16)
07500 A302: MOVE J5 ; 05300 302 IF(R8.NE.0.AND.J5.NE.-4)J5=-2
07600 MOVE 02,R8 ;J5=-4 MAKES REPEAT BAR SIGN
07700 JUMPE 02,.+5
07710 CAMN [-4]
07720 JRST .+3
07800 MOVNI 2
07900 MOVEM J5
08000 ; 05400 C R8 PUTS NUMBER OVER WHOLE REST ONLY.
08100 ; 05500 IF(J5.GT.1)R4=R4-2
08200 CAIG 1
08300 JRST .+3
08400 MOVSI 02,575400
08500 FADRM 02,R4
08600 ; 05700 R7=R6*10.
08700 MOVSI 02,204500
08800 FMPR 02,R6
08900 MOVEM 02,R7
09000 ; 05800 C FOR DOTS
09100 CAIGE 2 ; 05850 IF(J5.GE.2)R3=R3-3.0*RSTJ2
09200 JRST .+5
09300 MOVSI 02,202600
09400 FMPR 02,RSTJ2
09500 FSBRM 02,R3
09600 MOVNS 00,R3
09700 ; 05875 C SHIFTS 1/16 AND SMALLER RESTS .5 TO LEFT
09800 ; 05900 202 CALL REST
09900 A202: JSA 16,REST
10000 ; 06000 IF(J5.GT.1)GO TO 200
10100 MOVEI 02,1
10200 CAMGE 02,J5
10300 JRST A200
10400 SKIPN R7 ; 06100 IF(R7.EQ.0)RETURN
10500 JRA 16,(16)
10600 ; 06200 201 RA=14
10700 A201: MOVSI 02,204700
10800 ; 06300 R6=0
10900 SETZM R6
11000 SKIPGE J5 ; 06400 IF(J5)RA=19
11100 MOVSI 02,205460
11200 ;; MOVEM 02,RA
11300 ; 06500 R3=R3+RA*RSTJ2
11400 FMPR 02,RSTJ2
11500 FADRM 02,R3
11600 ; 06600 R4=8.+R4
11700 MOVSI 02,204400
11800 FADRM 02,R4
11900 ; 06700 JA=9
12000 MOVEI 02,11
12100 MOVEM 02,JA
12200 ; 06800 J5=7
12300 MOVEI 02,7
12400 MOVEM 02,J5
12500 ; 06900 C IF P6=1 THE REST IS DOTTED
12600 ; 07000 CALL CENTX
12700 JSA 16,CENTX
12800 ; 07100 GO TO 242
12900 JRST A242
13000 ; 07200 200 J5=J5-1
13100 A200: SOS J5
13200 ; 07300 C FOR MULTIPLE TAILS ON 16TH REST, ETC.
13300 ; 07400 R4=R4+2.
13400 MOVSI 02,202400
13500 FADRM 02,R4
13600 ; 07500 CALL RJBX(4.3)
13700 JSA 16,RJBX
13800 JUMP 02,[4.3]
13900 ; 07600 GO TO 202
14000 JRST A202
14100 A29: MOVEM 02,RJX ; 07800 29 RJX=R3
14200 ; 07900 RJY=CENTR+RSTJ2
14300 MOVE 02,RSTJ2
14400 FADR 02,CENTR
14500 MOVEM 02,RJY
14600 ; 08000 108 IF(WHOLE.NE.0)RJX=RJX+3.*RMINI
14700 A108: MOVE 02,WHOLE#
14800 JUMPE 02,.+5
14900 MOVSI 02,202600
15000 FMPR 02,RMINI
15100 FADRM 02,RJX
15200 ; 08100 C WHOLE=1 MEANS IT'S A WHOLE NOTE (WIDER THAN A HALF.)
15300 ; 08200 WHOLE=0
15400 SETZM WHOLE
15500 ; 08210 RG=9
15600 MOVSI 02,204440
15700 SKIPGE PLT ; 08220 IF(PLT)RG=17
15800 MOVSI 2,205420
15900 MOVEM 02,RG ; 08230 DOESN'T FILL DOT ON DPY
16000 ; 08300 107 CALL RDRAW(1,RG,RDOT,RMINI,RJX,RJY,RMINI)
16100 A107: JSA 16,RDRAW
16200 JUMP 00,[1]
16300 JUMP 02,RG
16400 JUMP 02,RDOT
16500 JUMP 02,RMINI
16600 JUMP 02,RJX
16700 JUMP 02,RJY
16800 JUMP 02,RMINI
16900 ;08400 **** **** *** ↑↑↑↑↑↑↑↑↑↑ THESE WERE RSTJ2 11/74
17000 ; 08500 IF(JA.EQ.1)GO TO 290
17100 MOVEI 02,1
17200 CAMN 02,JA
17300 JRST A290
17400 ; 08600 IF(R7.GE.20.)GO TO 290
17500 MOVSI 02,205500
17600 CAMG 02,R7
17700 JRST A290
17800 ; 08700 RB=POS+52.*RSTJ2
17900 MOVSI 02,206640
18000 FMPR 02,RSTJ2
18100 FADR 02,POS
18200 MOVEM 02,RB
18300 CAME 2,RJY ; 08800 IF(RJY.NE.RB)GO TO 6241
18400 JRST A6241
18500 ; 08900 C WHERE IS RB USED LATER?
18600 ; 09000 RJY=RJY-12*RSTJ2
18700 MOVSI 02,204600
18800 FMPR 02,RSTJ2
18900 FSBRM 02,RJY
19000 MOVNS 00,RJY
19100 ; 09100 GO TO 107
19200 JRST A107
19300 ; 09200 C ABOVE FOR DOTS
19400 ; 09300 290 R7=R7-10.
19500 A290: MOVN 02,[10.0]
19600 FADRB 02,R7
19700 CAMGE 2,[10.0] ; 09400 IF(R7.LT.10.)GO TO 1342
19800 JRST A1342
19900 ; 09500 RJX=RJX+RSTJ2*10.
20000 MOVSI 02,204500
20100 FMPR 02,RSTJ2
20200 FADRM 02,RJX
20300 ; 09600 GO TO 107
20400 JRST A107
20500 ; 10000 C NOTES****
20600 ; 10200 11 CALL NTS
20700 A11: JSA 16,NTS
20800 SKIPGE STEM ; 10300 IF(STEM)RETURN
20900 JRA 16,(16)
21000 ; 10400 R4=RX4
21100 MOVE 02,.COMM.+=42
21200 MOVEM 02,R4
21300 ; 23500
21400
21500 ; 31500 1242 IF(R7.LT.10.)GO TO 1342
21600 A1242: MOVSI 02,204500
21700 CAMLE 02,R7
21800 JRST A1342
21900 ; 31600 C FOR DOTTED NOTE-- P7>9
22000 ; 31700 RJX=RJAC+(22.+AMOD(R7,1.0)*59.6)*RMINI
22100 JSA 16,AMOD
22200 JUMP 02,R7
22300 JUMP 02,[1.0]
22400 FMPR 00,[59.6]
22500 FADRI 00,205540
22600 FMPR 00,RMINI
22700 FADR 00,RJAC
22800 ;; MOVEM 00,RJX
22900 ; 31800 C***↑↑↑↑↑ WAS 24. 11/74
23100 MOVE 02,RSTJ2 ;31900 RJY=CENTR+RSTJ2
23200 FADR 02,CENTR
23300 MOVEM 02,RJY
23305 MOVE 2,JY ; TO USE LATER
23310 MOVSI 3,207620 ; IF(R7.LT.100)GO TO A12
23320 CAMLE 3,R7
23330 JRST A12 ; SAVE +100 OR -100 IN AC3
23340 MOVNS 3 ; R7=R7-100
23350 FADRM 3,R7 ;ADD 100 TO R7 TO PUT DOT BELOW NOTE.
23355 CAIE 2,=20 ; SKIP NEXT IF JY=20 (NOTE TO LFT OF STEM)
23360 FADR 0,[14.54] ; RJX=RJX+14.54
23500 A12: CAIN 2,12 ;32000 IF(JY.EQ.10)RJX=RJX+14.54
24000 FADR 0,[14.54] ;32200 4322 RJX=RJX+RSTM
24200 MOVEM 0,RJX ; PUT AWAY RJX
24300 ;32300 C MOVES DOT TO LEFT
24500 A3322: MOVE J4 ;32400 3322 IF(MOD(J4,2).EQ.0)GO TO 108
24600 IDIVI 2
24700 JUMPE 1,A108 ; 32500 RX=RST7
24900 MOVE 02,ALF+=46
25000 ;;; MOVE JY ; 32600 IF(JY.GE.20)RX=-RX
25050 SKIPGE 3 ; IF -100 RX=-RX
25100 ;; CAIL =20
25200 MOVNS 2 ; ADD 100 TO R7 FOR DOTS BELOW! NOTE
25400 FADRM 02,RJY ;32700 3342 RJY=RJY+RX
25500 ; 32800 GO TO 108
25600 JRST A108 ; 33000 1342 IF(J5.NE.0)GO TO 5322
25900 A1342: MOVE 02,J5
26000 JUMPN 02,A5322
26100 SKIPN R6 ; 33100 IF(R6.EQ.0)RETURN
26200 JRA 16,(16)
26300 ; 33200 5322 R3=R3-R5*59.6*RMINI
26400 A5322: MOVE 02,[59.6]
26500 FMPR 02,R5
26600 FMPR 02,RMINI
26700 FSBRM 02,R3
26800 MOVNS 00,R3
26900 ; 33300 C TO SPACE OUT ACCIDS.
27000 ; 33700 242 IF(J5.GE.0)GO TO 2421
27100 A242: MOVE 02,J5
27200 JUMPGE 02,A2421
27300 ; 33800 RINV=-RINV
27400 MOVNS 00,RINV
27500 ; 33900 J5=-J5
27600 MOVNS 00,J5
27700 ;34000 NOW THAT 0 IS NOT USED FOR DOTS THE ABOVE 3 LINES COULD BE CHNGD
27800 ; 34100 C********** LAST # WAS 281?
27900 ; 34200 C B,#,NAT, ACC ↑, ACC >, FERMATA, DOT, REP MEAS., DASH
28000 ; 34400 2421 J5X=-1
28100 A2421: SETOM J5X
28200 ; 34500 JAX=JA
28300 MOVE 02,JA
28400 MOVEM 02,JAX#
28500 ; 34600 C USED AT 4241 FOR DOUBLE MARKS ON NOTES.
28600 ; 34700 IF(JA.EQ.9)GO TO 2423
28700 MOVEI 02,11
28800 CAMN 02,JA
28900 JRST A2423
29000 ; 34800 IF(J5.GT.3)GO TO 3121
29100 MOVE 1,J5
29200 CAILE 1,3 ; AC1 IS USED AT A211!!!
29300 JRST A3121
29400 ;34900 C DBL FLT(4) AND DBL SHRP(5) ALWAYS USE 'DRAW' ROUTINE.
29600 JRST A211 ; 35000 GO TO 211
29800 ; 35100 2423 RJZ=R4
29900 A2423: MOVE 02,R4
30000 MOVEM 02,RJZ
30100 ; 35200 C FOR 'DRWNT' WHEN PLOTTING.
30200 ; 35300 CALL NOZERO(R6)
30300 SKIPN 2,R6
30400 MOVE 2,[1.0]
30500 ; 35400 C R6=SIZE FACTOR (P6)
30600 ; 35500 RMINI=RMINI*R6
30800 FMPRM 02,RMINI
30900 ; 35600 R6=0
31000 SETZM R6
31100 ; 35700 STEM=0
31200 SETZM STEM
31300 ; 35800 C FOR MISC. ITEMS
31400 A210: MOVM J4 ; 35900 210 IF(IABS(J4).LT.100)GO TO 1241
31500 CAIGE 00,144
31600 JRST A1241
31700 MOVE J4 ; 36100 J4=MOD(J4,100)
31800 IDIVI =100
31900 MOVEM 1,J4
32000 ; 36200 RMINI=.7*RMINI
32100 MOVE 02,[0.7]
32200 FMPRM 02,RMINI
32300 ; 36400 C FOR 2 MARKS AT ONCE.
32400 A1241: MOVE J5 ; 36500 1241 IF(J5.GE.11)GO TO 28
32500 CAIL 13
32600 JRST A28
32700 ; 36600 GO TO (211,211,211,28,28,222,249,60,27,27),J5
32800 SKIPLE 01,J5
32900 CAILE 01,12
33000 SKIPA 0
33100 M13: JRST @M13 (1)
33200 JUMP 00,A211
33300 JUMP 00,A211
33400 JUMP 00,A211
33500 JUMP 00,A28
33600 JUMP 00,A28
33700 JUMP 00,A222
33800 JUMP 00,A249
33900 JUMP 00,A60
34000 JUMP 00,A27
34100 JUMP 00,A27
34200 ; 36700 RETURN
34300 JRA 16,(16)
34400 ; 36800 C ERROR TRAP (I.E. J5=0)
34500 ; 36900 C FOR 1 OR 2 BAR REP SIGNS.
34600 ; 37000 60 CALL BREP
34700 A60: JSA 16,BREP
34800 ; 37100 RETURN
34900 JRA 16,(16)
35000 ; 37300 241 CALL LINES(R3,CENTR,3)
35100 A241: JSA 16,LINES
35200 JUMP 02,R3
35300 JUMP 02,CENTR
35400 JUMP 00,[3]
35500 ; 37400 GO TO 210
35600 JRST A210
35700 ; 37700 211 IF(J5.EQ.0)GO TO 2422
35800 ;;;A211: MOVE 02,J5
35900 A211: JUMPE 1,A2422
36000 ; 37800 C GETS BACK GOOD VERTICAL POS.
36100 CAILE 1,3 ; 37900 IF(J5.GT.3)GO TO 222
36200 JRST A222
36300 ; 38000 C FOR 2-PASS PLOTTING (-2=THIN LINES, -3=HEAVY LINES)
36400 ; 38100 IF(PLT)GO TO 3121
36500 MOVE 02,PLT
36600 JUMPL 02,A3121
36700 ; 38200 IF(JFONT.NE.0)GO TO 3121
36800 MOVE 02,FONT
36900 JUMPN 02,A3121
37000 ; 38300 X=NACCI(J5)
37100 ;; MOVE 03,J5
37200 MOVE 02,NACCI -1(1)
37300 ;;; MOVEM 02,X
37400 ;38400 CALL RDRAW(X+1,RACCI(X),RACCI,RMINI,R3,CENTR,RMINI)
37500 ;;; MOVEI 02,1
37600 ;;; ADD 02,X
37650 AOJ 2,
37700 MOVEM 02,%TEMP.
37800 ;;; MOVE 04,X
37900 ;;; MOVEI 03,RACCI -1(4)
37910 MOVEI 03,RACCI -2(2)
38000 HRRM 03,AA14
38100 JSA 16,RDRAW
38200 JUMP 00,%TEMP.
38300 AA14: JUMP 02,AA14
38400 JUMP 02,RACCI
38500 JUMP 02,RMINI
38600 JUMP 02,R3
38700 JUMP 02,CENTR
38800 JUMP 02,RMINI
38900 ; 38500 2422 IF(R6.EQ.0)RETURN
39000 A2422: SKIPN 2,R6
39100 JRA 16,(16)
39110 CAMGE 2,[0.1] ;IF(R6.LT..1)RETURN 4/76
39120 JRA 16,(16) ;SO UP TO .0099 CAN BE PUT IN P6 FOR 'EXTRA'
39200 ; 38600 J5=(R6+.001)*100.
39300 MOVE 02,[0.001]
39400 FADR 02,R6
39500 FMPRI 02,207620
39600 KIFIX 0,2 ; JSA 16,IFIX
39700 ; JUMP 00,2
39800 MOVEM 00,J5
39900 ; 38700 R4=RX4
40000 MOVE 02,.COMM.+=42
40100 MOVEM 02,R4
40200 ; 38900 R3=RJAC
40300 MOVE 02,RJAC
40400 MOVEM 02,R3
40500 A1249: MOVE J5 ; 39000 1249 IF(MOD(J5,10).GT.3)GO TO 249
40600 IDIVI 12
40700 CAILE 1,3
40800 JRST A249
40900 ; 39100 J5=J5/10
41000 MOVEM 0,J5
41100 CAIL =40 ;39200 IF(J5.GT.39)GO TO 1249
41200 JRST A1249
41300 ; 39300 C WHEN P1=1, EXTRACTS ACCENT NUMBERS FROM DECIMALS IN P6.
41400 ; 39400 249 IF(J5.GT.30)GO TO 28
41500 A249: MOVE J5
41600 CAILE 36
41700 JRST A28
41800 CAILE 12 ; 39500 IF(J5.GT.10)GO TO 246
41900 JRST A246
42000 SKIPN J5 ; 39600 IF(J5.EQ.0)RETURN
42100 JRA 16,(16)
42200 ; 39700 IF(JA.NE.1)GO TO 250
42300 MOVEI 02,1
42400 CAME 02,JA
42500 JRST A250
42600 ; 39900 RB=14.
42700 MOVSI 02,204700
42800 MOVEM 02,RB
42900 MOVE 1,J4 ; 40000 IF(MOD(J4,2).EQ.0)GO TO 244
43000 IDIVI 1,2
43100 JUMPE 2,A244
43200 CAIN 7 ; 40100 IF(J5.EQ.7)GO TO 6322
43300 JRST A6322
43400 CAIE =9 ; 40200 IF(J5.NE.9)GO TO 244
43500 JRST A244
43600 A6322: MOVE 3,J4 ; 40300 6322 IF(STEM.GT.1)GO TO 7322
43700 MOVE 1,STEM
43800 CAILE 1,1
43900 JRST A7322
44000 ; 40400 IF(J4.LT.5)GO TO 244
44200 CAIGE 3,5
44300 JRST A244
44400 A7322: CAIG 3,=9 ;40500 7322 IF(J4.LE.9)GO TO 8322
44500 JRST A8322
44600 CAIN 1,2 ; 40600 IF(STEM.EQ.2)GO TO 244
44700 JRST A244
44800 JUMPE 1,A244 ; 40700 IF(STEM.EQ.0)GO TO 244
44900 ; 40800 8322 RB=21
45000 A8322: MOVSI 02,205520
45100 MOVEM 02,RB
45200 ;40900 C PUTS ACCENT DOWN OR UP 1 SPACE. AVOIDS PUTTING DOT OR DASH ON LINE
45300 A244: MOVE 2,STEM ; 41000 244 IF(STEM.EQ.1)GO TO 9322
45400 CAIN 2,1
45500 JRST A9322
45600 JUMPN 2,A245 ; 41100 IF(STEM.NE.0)GO TO 245
45700 ; 41200 IF(J4.GE.7)GO TO 245
45800 MOVEI 02,7
45900 CAMG 02,J4
46000 JRST A245
46100 ; 41300 9322 RB=-RB
46200 A9322: MOVNS 00,RB
46300 ; 41700 245 CENTR=CENTR+RB*RSTX
46400 A245: MOVE 02,ALF+=48
46500 FMPR 02,RB
46600 FADRM 02,CENTR
46700 A250: CAILE 12 ;41800 250 IF(J5.GT.10)GO TO 281
46800 JRST A281
46900 CAIGE 6 ; 41900 IF(J5.LT.6)GO TO 281
47000 JRST A281
47100 ; 42000 JA=9
47200 MOVEI 02,11
47300 MOVEM 02,JA
47400 CAIE 7 ; 42100 IF(J5.NE.7)GO TO 253
47500 JRST A253
47600 ; 42200 C 7=DOT
47700 ; 42300 RXX=R3
47800 MOVE 02,R3
47900 MOVEM 02,RXX
48000 ; 42400 R3=R3+6.7*RMINI
48100 MOVE 02,[6.7]
48200 FMPR 02,RMINI
48300 FADRB 02,R3
48400 ; 42500 C CENTERS THE DOT
48500 ; 42600 GO TO 29
48600 JRST A29
48700 A253: CAIN 11 ; 42700 253 IF(J5.EQ.9)GO TO 271
48800 JRST A271
48900 ; 42800 C 9=DASH
49000 ; 42900 251 IF(RB.LT.0)RINV=-RINV
49100 A251: SKIPGE RB
49200 ; 43000 C FIX THIS!!!! FOR BOWINGS, ETC.
49300 A2222: CAIE 24 ; 43100 2222 IF(J5.NE.20)GO TO 2223
49400 JRST A2223
49500 ; 43300 JA=7
49600 MOVEI 02,7
49700 MOVEM 02,JA
49800 ; 43400 R5=0
49900 SETZM R5
50000 ; 43500 J7=1
50100 MOVEI 02,1
50200 MOVEM 02,J7
50300 ; 43600 CALL ALPHA
50400 JSA 16,ALPHA
50500 ; 43700 C FOR TRILL -- J5=20
50600
50700 JRA 16,(16)
50800 A2223: CAIN 21 ; 43900 2223 IF(J5.EQ.17)GO TO 323
50900 JRST A323
51000 CAIE 22 ; 44000 IF(J5.NE.18)GO TO 222
51100 JRST A222
51200 ; 44100 323 RINV=J5
51300 A323: FLTR 0,0 ;TLC 0,232000 FLOAT IT.
51400 ;FADR 0,0
51500 MOVEM 0,RINV
51600 ; 44200 C FOR MORD, INV.MORD
51700 ; 44300 222 CALL FERMTA
51800 A222: JSA 16,FERMTA
51900 ; 44400 GO TO 5241
52000 JRST A5241
52100 A246: CAIGE 12 ; 44800 246 IF(J5.LT.10)GO TO 245
52200 JRST A245
52300 ; 45020 RZ=3
52400 MOVSI 02,202600
52500 ; 45040 IF(STEM.EQ.1)RZ=9+R8
52600 MOVEI 3,1
52700 CAME 3,STEM
52800 JRST .+3
52900 MOVSI 02,204440
53000 FADR 02,R8
53100 ;;;;;; MOVEM 02,RZ
53200 ; 45060 R4=R4+RZ*RMINI/RSTJ2
53300 FMPR 02,RMINI
53400 FDVR 02,RSTJ2
53500 FADRB 02,R4
53600 CAML 2,[12.5] ; 45100 IF(R4.LT.12.5)R4=12.5
53700 JRST .+3
53800 MOVSI 02,204620
53900 MOVEM 02,R4
54000 ; 45200 CALL CENTX
54100 JSA 16,CENTX
54200 MOVE J5 ; 45300 IF(J5.EQ.26)GO TO 222
54300 CAIN 32
54400 JRST A222
54500 ; 45400 C 26 IS NEW NUMB FOR FERMATA.
54600 A28: CAIGE 36 ; 45500 28 IF(J5.LT.30)GO TO 281
54700 JRST A281
54710 CAIL =40 ;IF(J5.GE.40)GO TO A28X
54720 JRST A28X
54730 SUBI =30 ;R5=J5-30 GET THE 1 DIGIT NUM.
54740 FLTR ; FLOAT IT
54750 MOVEM .COMM.+6 ; R5
54760 MOVSI 200600 ;0.75
54770 MOVEM .COMM.+7 ; R6=.75 SIZE OF NUM.
54780 MOVE .COMM.+=23 ;R3=RX3 GET REAL R3 BACK
54790 MOVEM .COMM.+4
54800 SETZM .COMM.+=8 ;R7=0
54810 SETZM .COMM.+=9 ;R8=0
54820 SETZM .COMM.+=10 ;R9=0
54830 MOVSI 202500 ;RA=2.5
54840 MOVEI 2,1 ;IF(STEM.EQ.2)RA=-RA
54850 CAMN 2,STEM
54860 MOVNS
54870 FADR .COMM.+=42 ;R4=RX4+RA HGT OF NUM.
54880 MOVEM .COMM.+5
54890 JSA 16,MAKNUM ;CALL MAKNUM(R5)
54900 JUMP .COMM.+6
54910 JRA 16,(16) ;ADD HERE FOR NUMS WITH ACCENTS, ETC.
54990 A28X: IDIVI 12 ; 45600 J5X=MOD(J5,10)
55000 MOVEM 1,J5X
55100 ; 45700 C J5X SAVES NEXT MARK.
55200 CAIGE 1,4 ; 45800 IF(J5X.LT.4)J5X=0
55300 SETZM J5X
55400 ; 45900 J5=J5/10
55500 MOVEM 0,J5
55600 CAILE =30 ; 46000 IF(J5.GT.30)RETURN
55700 JRA 16,(16)
55800 ; 46100 C WON'T READ 415 ETC. (CORRECT=154)
55900 ; 46200 C DOES BOTTOM MARK FIRST, THEN TOP.
56000 ; 46300 CALL EXCH(J5X,J5)
56100 EXCH J5X
56200 MOVEM J5
56300 ; 46400 C PUTS UPBOW, DNBOW, ETC. ABOVE STACC., ETC.
56400 ; 46500 IF(JA.EQ.1)GO TO 249
56500 MOVEI 02,1
56600 CAMN 02,JA
56700 JRST A249
56800 ; 46600 GO TO 1241
56900 JRST A1241
57000 ; 46700 281 X=1
57100 A281: MOVEI 02,1
57200 MOVEM 02,X#
57300 CAILE =16 ; 46800 IF(J5.GT.16)GO TO 2222
57400 JRST A2222
57500 ; 46900 C JUMP FOR MORD, INV.MORD, TRILL
57600 CAIE 4 ; 47000 IF(J5.NE.4)GO TO 228
57700 JRST A228
57800 ; 47100 X=5
57900 MOVEI 02,5
58000 MOVEM 02,X
58100 ; 47200 CALL RJBX(.5)
58200 JSA 16,RJBX
58300 JUMP 02,[0.5]
58400 ; 47300 GO TO 328
58500 JRST A328
58600 ; 47400 228 IF(J5.GT.10)X=XAC(J5-10)
58700 A228: CAIG 12
58800 JRST .+4
58900 MOVE 03,J5
59000 MOVE 02,XAC -13(3)
59100 MOVEM 02,X
59200 ; 47500 C X IS POINTER IN RACNT ARRAY
59300 ; 47600 328 RA=RMINI
59400 A328: MOVE 02,RMINI
59500 MOVEM 02,RA
59600 ; 47700 C OR RSTJ2?
59700 ; 47800 IF(RINV.LT.0)GO TO 1323
59800 MOVE 02,RINV
59900 JUMPL 02,A1323
60000 ; 47900 IF(STEM.NE.1)GO TO 2323
60100 MOVEI 02,1
60200 CAME 02,STEM
60300 JRST A2323
60400 CAIE 4 ; 48000 IF(J5.NE.4)GO TO 2323
60500 JRST A2323
60600 ; 48100 1323 RA=-RA
60700 A1323: MOVNS 00,RA
60800 ; 48200 C ↑↑↑ X ↑↑↑ PICKS UP TYPO ERRORS
60900 ;48300 2323 IF(X.LT.54)CALL RDRAW(X+1,RACNT(X),RACNT,RA,R3,CENTR,RMINI)
61000 A2323: MOVEI 02,66
61100 CAMG 02,X
61200 JRST A5241
61300 MOVEI 02,1
61400 ADD 02,X
61500 MOVEM 02,%TEMP.
61600 MOVE 04,X
61700 MOVEI 03,RACNT -1(4)
61800 HRRM 03,AA24
61900 JSA 16,RDRAW
62000 JUMP 00,%TEMP.
62100 AA24: JUMP 02,AA24
62200 JUMP 02,RACNT
62300 JUMP 02,RA
62400 JUMP 02,R3
62500 JUMP 02,CENTR
62600 JUMP 02,RMINI
62700 ;48400 PTR, WDCNT, ARRAY,Y MULT,HOR ADD,VERT ADD, X,Y,MULT
62800 ;48500 IN ARRAY, 33.012 WOULD BE X=33, Y=12. 101.123 IS X=-1, Y=-23.
62900 ; 48600 GO TO 5241
63000 JRST A5241
63100 ; 48700 4241 JJJ=J5
63200 A4241: MOVE 1,J5
63300 MOVEM 1,JJJ
63400 ; 48800 J5=J5X
63500 MOVE J5X
63600 MOVEM J5
63700 ; 48900 J5X=-1
63800 SETOM J5X
63900 ; 49000 IF(JAX.NE.1)GO TO 7241
64000 MOVEI 02,1
64100 CAME 02,JAX
64200 JRST A7241
64300 CAILE 12 ; 49100 IF(J5.GT.10)GO TO 246
64400 JRST A246
64500 CAIE 7 ; 49200 IF(J5.NE.7)GO TO 7241
64600 JRST A7241
64700 CAIE 1,=9 ; 49300 IF(JJJ.NE.9)GO TO 249
64800 JRST A249
64900 ; 49400 7241 RXX=8.5*RMINI
65000 A7241: MOVSI 02,204420
65100 FMPR 02,RMINI
65200 MOVEM 02,RXX
65300 ; 49500 C↑↑↑↑↑↑ 11/74 WAS RH*
65400 ; 49600 IF(STEM.EQ.1)RXX=-RXX
65500 MOVEI 02,1
65600 CAMN 02,STEM
65700 MOVNS 00,RXX
65800 ; 49700 CENTR=CENTR+RXX
65900 MOVE 02,RXX
66000 FADRM 02,CENTR
66100 CAIE 32 ; 49800 IF(J5.EQ.26)J5=6
66200 JRST A1241
66300 MOVEI 02,6
66400 MOVEM 02,J5
66500 ; 49900 C TEMPORARY?? FIX
66600 ; 50000 GO TO 1241
66700 JRST A1241
66800 ; 50100 C >=5, ↑=4
66900 ; 50200 27 R3=J3
67000 A27: FLTR 2,J3 ;MOVE 2,J3
67100 ; TLC 2,232000
67200 ; FADR 2,2
67300 MOVEM 2,R3 ; 50300 C DASHES
67400 ; 50400 271 CALL LINX(R3,CENTR,R3+RMINI*14.,CENTR)
67500 A271: MOVSI 02,204700
67600 FMPR 02,RMINI
67700 FADR 02,R3
67800 MOVEM 02,%TEMP.
67900 JSA 16,LINX
68000 JUMP 02,R3
68100 JUMP 02,CENTR
68200 JUMP 02,%TEMP.
68300 JUMP 02,CENTR
68400 ;50500 C **** **** *** ↑↑↑↑↑↑↑↑↑↑ THIS WAS RSTJ2 11/74
68500 ; 50600 5241 IF(J5X.GT.0)GO TO 4241
68600 A5241: MOVE 02,J5X
68700 JUMPG 02,A4241
68800 ; 50700 C J5X IS FOR DOUBLE MARKS. (WHAT ABOUT DOT POSITION.)
68900 ; 50800 RETURN
69000 JRA 16,(16)
69100 ; 50900 6241 R3=RXX
69200 A6241: MOVE 02,RXX
69300 MOVEM 02,R3
69400 ; 51000 C RESET R3 AFTER A DOT.
69500 ; 51100 GO TO 5241
69600 JRST A5241
69700 ; 51200 3121 J5=J5+9
69800 A3121: MOVEI 02,11
69900 ADDM 02,J5
70000 ; 51300 C SOON WILL HAVE DBL FLAT (4) AND DBL SHRP (5)
70100 ;51400 C TO DRAW GOOD ACCIS ON PLOTTER - NOT ON DPY.(IN CLEF4.DMD)
70200 ; 51500 CALL DRWNT
70300 JSA 16,DRWNT
70400 ; 51600 GO TO 2422
70500 JRST A2422
70600 END ; 51700 END